home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tool-inc.zip / DOSIO.INC < prev    next >
Text File  |  1989-06-02  |  6KB  |  245 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13.  
  14. (*
  15.  * dosio - library for interface to dos v2 file access functions
  16.  *
  17.  * usage:
  18.  *
  19.  *  fd := dos_create('name',attributes)
  20.  *  if dos_unlink('name') = dos_error then ...
  21.  *  fd := dos_open('name',open_(read write update))
  22.  *  if dos_close(fd) = dos_error then ...
  23.  *  count := dos_read(fd,buffer,sizeof(buffer))
  24.  *  count := dos_write(fd,buffer,sizeof(buffer))
  25.  *  integer_pos := dos_seek(fd,seek_(start cur end),integer_offset)
  26.  *  real_pos := dos_lseek(fd,seek_*,real_offset)
  27.  *  dos_file_times(fd,time_(set get),time,date);
  28.  *
  29.  *)
  30.  
  31.  
  32. type
  33.  
  34.    dos_filename = string[64];
  35.    dos_handle   = integer;
  36.  
  37.    dos_seek_methods = (seek_start,
  38.                        seek_cur,
  39.                        seek_end);
  40.  
  41.    dos_time_functions = (time_get,
  42.                          time_set);
  43.  
  44.  
  45. const
  46.    dos_error = -1;
  47.    stdin = 0;
  48.    stdout = 1;
  49.    stderr = 2;
  50.  
  51.    open_read    = $40;   {deny_nothing, allow_read}
  52.    open_write   = $41;   {deny_nothing, allow_write}
  53.    open_update  = $42;   {deny_nothing, allow_read+write}
  54.  
  55.  
  56. var
  57.    dos_regs:     registers;
  58.    dos_name:     dos_filename;
  59.    dos_message:  string[90];
  60.  
  61.  
  62. procedure dos_call(var regs:  registers);
  63. begin
  64.    msdos(regs);
  65.  
  66.    if (regs.flags and 1) = 1 then
  67.    begin
  68.       case regs.ax of
  69.          1:   dos_message := 'invalid subfunction code';
  70.          2:   dos_message := 'file not found';
  71.          3:   dos_message := 'directory not found';
  72.          4:   dos_message := 'too many open files';
  73.          5:   dos_message := 'access denied';
  74.          6:   dos_message := 'invalid file handle';
  75.          else dos_message := 'unknown DOS error';
  76.       end;
  77.  
  78.       writeln('ERROR: ',dos_message,'  ( ',dos_name,')');
  79.       regs.ax := dos_error;
  80.    end;
  81. end;
  82.  
  83.  
  84. function dos_create(name:    dos_filename;
  85.                     attrib:  integer):  dos_handle;
  86. begin
  87.    dos_regs.ax := $3c00;
  88.    dos_regs.ds := seg(dos_name);
  89.    dos_regs.dx := ofs(dos_name)+1;
  90.    dos_regs.cx := attrib;
  91.    dos_name := name + #0;
  92.    dos_call(dos_regs);
  93.    dos_create := dos_regs.ax;
  94. end;
  95.  
  96.  
  97. function dos_unlink(name:    dos_filename):  dos_handle;
  98. begin
  99.    dos_regs.ax := $4100;
  100.    dos_regs.ds := seg(dos_name);
  101.    dos_regs.dx := ofs(dos_name)+1;
  102.    dos_name := name + #0;
  103.    dos_call(dos_regs);
  104.    dos_unlink := dos_regs.ax;
  105. end;
  106.  
  107.  
  108. (* dos_open(name,mode) -> handle or dos_error *)
  109.  
  110. function dos_open(name:    dos_filename;
  111.                   mode:    integer):  dos_handle;
  112. var
  113.    try: integer;
  114.  
  115. const
  116.    retry_count = 3;
  117.  
  118. begin
  119.    dos_name := name + #0;
  120.  
  121.    for try := 1 to retry_count do
  122.    begin
  123.       dos_regs.ax := $3d00 + mode;
  124.       dos_regs.ds := seg(dos_name);
  125.       dos_regs.dx := ofs(dos_name)+1;
  126.       msdos(dos_regs);
  127.       dos_open := dos_regs.ax;
  128.       if (dos_regs.flags and 1) = 0 then
  129.          exit;
  130.    end;
  131.  
  132.    dos_open := dos_error;
  133. end;
  134.  
  135.  
  136. function dos_close(handle:  dos_handle):  dos_handle;
  137. begin
  138.    dos_regs.ax := $3e00;
  139.    dos_regs.bx := handle;
  140.    dos_call(dos_regs);
  141.    dos_close := dos_regs.ax;
  142. end;
  143.  
  144.  
  145. (* read(fd,buffer,bytecount) -> bytesread or dos_error *)
  146.  
  147. function dos_read(handle:  dos_handle;
  148.                   var buffer;
  149.                   bytes:   integer):   dos_handle;
  150. begin
  151.    dos_regs.ax := $3f00;
  152.    dos_regs.bx := handle;
  153.    dos_regs.cx := bytes;
  154.    dos_regs.ds := seg(buffer);
  155.    dos_regs.dx := ofs(buffer);
  156.    dos_call(dos_regs);
  157.    dos_read := dos_regs.ax;
  158. end;
  159.  
  160.  
  161. (* write(fd,buffer,bytecount) -> byteswritten or dos_error *)
  162.  
  163. function dos_write(handle:  dos_handle;
  164.                    var buffer;
  165.                    bytes:   integer):   dos_handle;
  166. begin
  167.    dos_regs.ax := $4000;
  168.    dos_regs.bx := handle;
  169.    dos_regs.cx := bytes;
  170.    dos_regs.ds := seg(buffer);
  171.    dos_regs.dx := ofs(buffer);
  172.    dos_call(dos_regs);
  173.    dos_write := dos_regs.ax;
  174.    if dos_regs.ax <> bytes then
  175.       writeln('ERROR: write failed (disk full?)');
  176. end;
  177.  
  178.  
  179. (* seek(fd,method,offset) -> new file position *)
  180.  
  181. function dos_seek(handle:  dos_handle;
  182.                   method:  dos_seek_methods;
  183.                   offset:  integer):  dos_handle;
  184. begin
  185.    dos_regs.ax := $4200 + ord(method);
  186.    dos_regs.bx := handle;
  187.    dos_regs.dx := offset;
  188.    dos_regs.cx := 0;
  189.    dos_call(dos_regs);
  190.    dos_seek := dos_regs.ax;
  191. end;
  192.  
  193.  
  194. (* lseek(fd,method,roffset) -> new file position *)
  195.  
  196. function dos_lseek(handle:  dos_handle;
  197.                    method:  dos_seek_methods;
  198.                    offset:  real):  real;
  199. var
  200.    dxv:  real;
  201.  
  202. begin
  203.    dos_regs.ax := $4200 + ord(method);
  204.    dos_regs.bx := handle;
  205.    dos_regs.cx := itrunc(offset / 65536.0);
  206.  
  207.    dxv := offset - 65536.0*int(dos_regs.cx);
  208.    if dxv > int($7fff) then
  209.       dxv := dxv - 65536.0;
  210.  
  211.    if dxv = $8000 then
  212.       dos_regs.dx := $8000
  213.    else
  214.       dos_regs.dx := itrunc(dxv);
  215.  
  216.    dos_call(dos_regs);
  217.  
  218.    if dos_regs.ax = dos_error then
  219.       dos_lseek := dos_error
  220.    else
  221.       dos_lseek := int(dos_regs.dx) * 65536.0 +
  222.                    int(dos_regs.ax shr 1) * 2.0 +
  223.                    int(dos_regs.ax and 1);
  224. end;
  225.  
  226.  
  227. (* dos_file_times(fd,time_(set get),time,date); *)
  228.  
  229. procedure dos_file_times(fd:       dos_handle;
  230.                          func:     dos_time_functions;
  231.                          var time: integer;
  232.                          var date: integer);
  233. begin
  234.    dos_regs.ax := $5700 + ord(func);
  235.    dos_regs.bx := fd;
  236.    dos_regs.cx := time;
  237.    dos_regs.dx := date;
  238.    dos_call(dos_regs);
  239.    time := dos_regs.cx;
  240.    date := dos_regs.dx;
  241. end;
  242.  
  243.  
  244.  
  245.